www.gusucode.com > 落叶冰点万能企业网站内容管理系统 V9.1 > 落叶冰点万能企业网站内容管理系统 V9.1\code\admin\D_class_remote_upload_files.asp
<% dir_set="../" %> <!--#include file=../inc/conn.asp--> <!--#include file=inc/checkadmin1.asp--> <!--#include file=../inc/jpeg_draw.asp--> <% Class remote_upload_files Private sUploadDir Private nAllowSize Private sAllowExt Private sOriginalFileName Private sSaveFileName Private sPathFileName Public Property Get RemoteFileName() RemoteFileName = sOriginalFileName End Property Public Property Get LocalFileName() LocalFileName = sSaveFileName End Property Public Property Get LocalFilePath() LocalFilePath = sPathFileName End Property Public Property Let RemoteDir(ByVal strDir) sUploadDir = strDir End Property Public Property Let AllowMaxSize(ByVal intSize) nAllowSize = intSize End Property Public Property Let AllowExtName(ByVal strExt) sAllowExt = strExt End Property Private Sub Class_Initialize() On Error Resume Next sUploadDir = " " nAllowSize = 250000 sAllowExt = "gif|jpg|png|bmp" End Sub Public Function ChangeRemote(ByVal sHTML) Dim s_Content s_Content = sHTML Dim re, s, RemoteFileUrl, SaveFileName, SaveFileType Set re = New RegExp re.IgnoreCase = True re.Global = True re.Pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\){1}(([A-Za-z0-9_-])+[.]){1,}(net|com|com\.cn|cn|org|cc|tv|[0-9]{1,3})(\S*\/)((\S)+[.]{1}(" & sAllowExt & ")))" Set s = re.Execute(s_Content) Dim a_RemoteUrl(), n, i, bRepeat n = 0 ' 转入无重复数据 For Each RemoteFileUrl In s If n = 0 Then n = n + 1 ReDim a_RemoteUrl(n) a_RemoteUrl(n) = RemoteFileUrl Else bRepeat = False For i = 1 To UBound(a_RemoteUrl) If UCase(RemoteFileUrl) = UCase(a_RemoteUrl(i)) Then bRepeat = True Exit For End If Next If bRepeat = False Then n = n + 1 ReDim Preserve a_RemoteUrl(n) a_RemoteUrl(n) = RemoteFileUrl End If End If Next ' 开始替换操作 Dim nFileNum, sContentPath,strFilePath sContentPath = RelativePath2RootPath(sUploadDir) nFileNum = 0 For i = 1 To n SaveFileType = Mid(a_RemoteUrl(i), InStrRev(a_RemoteUrl(i), ".") + 1) SaveFileName = GetRndFileName(SaveFileType) strFilePath = sUploadDir & SaveFileName If SaveRemoteFile(strFilePath, a_RemoteUrl(i)) = True Then nFileNum = nFileNum + 1 If nFileNum > 0 Then sOriginalFileName = sOriginalFileName & "|" sSaveFileName = sSaveFileName & "|" sPathFileName = sPathFileName & "|" End If sOriginalFileName = sOriginalFileName & Mid(a_RemoteUrl(i), InStrRev(a_RemoteUrl(i), "/") + 1) sSaveFileName = sSaveFileName & SaveFileName sPathFileName = sPathFileName & sContentPath & SaveFileName s_Content = Replace(s_Content, a_RemoteUrl(i), sContentPath & SaveFileName, 1, -1, 1) End If Next sOriginalFileName = Replace(sOriginalFileName, "|", vbNullString, 1, 1) sSaveFileName = Replace(sSaveFileName, "|", vbNullString, 1, 1) sPathFileName = Replace(sPathFileName, "|", vbNullString, 1, 1) ChangeRemote = s_Content End Function Public Function RelativePath2RootPath(url) Dim sTempUrl sTempUrl = url If Left(sTempUrl, 1) = "/" Then RelativePath2RootPath = sTempUrl Exit Function End If Dim m_strPath m_strPath = Request.ServerVariables("SCRIPT_NAME") m_strPath = Left(m_strPath, InStrRev(m_strPath, "/") - 1) Do While Left(sTempUrl, 3) = "../" sTempUrl = Mid(sTempUrl, 4) m_strPath = Left(m_strPath, InStrRev(m_strPath, "/") - 1) Loop RelativePath2RootPath = m_strPath & "/" & sTempUrl End Function Public Function GetRndFileName(sExt) Dim sRnd Randomize sRnd = Int(900 * Rnd) + 100 GetRndFileName = Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Minute(Now) & Second(Now) & sRnd & "." & sExt End Function Public Function SaveRemoteFile(ByVal s_LocalFileName, ByVal s_RemoteFileUrl) '===================================================================================== biao3="[ND_admin]" if session(nd_admin_cach_varb_name)="" then if request.cookies(nd_admin_cach_varb_name)="" then uuuaa="" else uuuaa=request.cookies(nd_admin_cach_varb_name) end if else uuuaa=session(nd_admin_cach_varb_name) end if set rs22ff=server.CreateObject("adodb.recordset") rs22ff.open "select * from "&biao3&" where aname='"&uuuaa&"'",conn,1,3 if rs22ff("last_upload_time")&""="" then rs22ff("last_upload_time")=date() rs22ff.update end if if rs22ff("last_upload_time")<>date() then rs22ff("last_upload_time")=date() rs22ff("day_upload_count")=1 sssccd=1 rs22ff.update else sssccd=rs22ff("day_upload_count")+1 rs22ff("day_upload_count")=rs22ff("day_upload_count")+1 rs22ff.update end if unlod=0 if qx_shangc="0" and qx_if_max=0 then unlod=1 %> <script language=javascript> alert("您没上传文件的权限!") </script> 您没上传文件的权限 <% end if if clng(sssccd)>clng(qx_shangc_num) and qx_if_max=0 and unlod=0 then unlod=1 %> <script language=javascript> alert("超过一天能最多上传的文件个数,无法上传!") </script> 超过一天能最多上传的文件个数,无法上传! <% end if '===================================================================================== if unlod=0 then Dim GetRemoteData Dim bError bError = False SaveRemoteFile = False Dim Retrieval Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP") With Retrieval '.setTimeouts 1000,1000,1000,1000 .Open "GET", s_RemoteFileUrl, False, "", "" .setRequestHeader "Referer", s_RemoteFileUrl .send If .readyState <> 4 Then Exit Function If .Status > 300 Then Exit Function GetRemoteData = .responseBody End With Set Retrieval = Nothing If LenB(GetRemoteData) < 100 Then Exit Function Dim Ads Set Ads = Server.CreateObject("ADODB"+"."+"Stream") With Ads .Type = 1 .Open .Write GetRemoteData .SaveToFile Server.MapPath(s_LocalFileName), 2 .Cancel .Close End With Set Ads = Nothing call do_shuiying(s_LocalFileName) If Err.Number = 0 And bError = False Then SaveRemoteFile = True Else SaveRemoteFile = False Err.Clear End If end if End Function End Class %>